home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 0187.ZIP / DODGE.PAS < prev    next >
Pascal/Delphi Source File  |  1985-01-20  |  12KB  |  492 lines

  1. (*
  2.  * dodge
  3.  * You are in a 30 x 15 square. There are 6 attackers, one tank,
  4.  * and you. If you hit one of the attackers (or the tank), you
  5.  * are destroyed. If two attackers hit each other, they are randomly
  6.  * put somewhere else. If an attacker hits the tank, then the
  7.  * attacker is destroyed. As an added bonus, there are 15 mines
  8.  * in the square (and the border of the square). If you hit a mine
  9.  * you are destroyed. If an attacker hits a mine, then the attacker
  10.  * is destroyed. Your object is to destroy the 6 attackers.
  11.  *
  12.  * You can move by:
  13.  *     812
  14.  *     703
  15.  *     654
  16.  *
  17.  * Note that 0 leaves you in the same place. A move of 9 will put you
  18.  * in some random place on the square (even on a mine)
  19.  *)
  20.  
  21. program dodge(input, output);
  22.  
  23. const
  24.    numattackers = 6;   (* number of attackers *)
  25.    length       = 30;  (* length of playing field *)
  26.    width        = 15;  (* width of playing field *)
  27.    numines      = 15;  (* number of mines *)
  28.    ninemax      = 2;   (* number of times the 9 escape can be used *)
  29.  
  30. type
  31.    (* what can be at a location *)
  32.    what = (me,attacker,tank,mine,nothing);
  33.  
  34.    xindex = 0..length;
  35.    yindex = 0..width;
  36.  
  37.    (* directions something can move *)
  38.    direction = (stay,n,ne,e,se,s,sw,w,nw,nowhere);
  39.  
  40.    (* the location of an object *)
  41.    loc = record
  42.       xcord : xindex;
  43.       ycord : yindex
  44.    end;
  45.  
  46. var
  47.    (* the playing field *)
  48.    square : array[1..width,1..length] of what;
  49.  
  50.    tankloc: loc;
  51.    myloc  : loc;
  52.    atack  : array[1..numattackers] of loc;
  53.  
  54.    ch     : char;
  55.    left   : 0..numattackers;
  56.    nines  : 0..ninemax;
  57.    saydir : direction;
  58.  
  59. procedure saywhat;
  60. begin
  61.    write('x = ',myloc.xcord,', y = ',myloc.ycord,', dir = ');
  62.    case saydir of
  63.       n    : writeln('n');
  64.       s    : writeln('s');
  65.       e    : writeln('e');
  66.       w    : writeln('w');
  67.       ne   : writeln('ne');
  68.       nw   : writeln('nw');
  69.       se   : writeln('se');
  70.       sw   : writeln('sw');
  71.       stay : writeln('stay');
  72.       nowhere: writeln('nothing');
  73.    end;
  74. end;
  75.  
  76.  
  77. (*
  78.  * makeboard
  79.  * creates the board and place every thing in at random places
  80.  *)
  81.  
  82. procedure makeboard;
  83.  
  84. var
  85.    placed : integer;
  86.    xloc   : xindex;
  87.    yloc   : yindex;
  88.    i,j    : integer;
  89.  
  90. begin
  91.    nines := ninemax;
  92.    for i := 1 to width do
  93.       for j := 1 to length do
  94.          square[i][j] := nothing;
  95.    left := numattackers;
  96.  
  97.    for i := 1 to length do
  98.    begin
  99.       square[1][i] := mine;
  100.       square[width][i] := mine
  101.    end;
  102.  
  103.    for i := 1 to width do
  104.    begin
  105.       square[i][1] := mine;
  106.       square[i][length] := mine
  107.    end;
  108.  
  109.    placed := 0;
  110.    while placed < numines do
  111.    begin
  112.       xloc := 1 + random(length);
  113.       yloc := 1 + random(width);
  114.       if square[yloc][xloc] = nothing then
  115.          begin
  116.             square[yloc][xloc] := mine;
  117.             placed := placed + 1
  118.          end
  119.    end;
  120.  
  121.    placed := 1;
  122.  
  123.    while placed <= numattackers do
  124.    begin
  125.       xloc := 1 + random(length);
  126.       yloc := 1 + random(width);
  127.       if square[yloc][xloc] = nothing then
  128.       begin
  129.          square[yloc][xloc] := attacker;
  130.          atack[placed].xcord := xloc;
  131.          atack[placed].ycord := yloc;
  132.          placed := placed + 1
  133.       end
  134.    end;
  135.  
  136.    while square[yloc][xloc] <> nothing do
  137.    begin
  138.       xloc := 1 + random(length);
  139.       yloc := 1 + random(width)
  140.    end;
  141.    square[yloc][xloc] := tank;
  142.    tankloc.xcord := xloc;
  143.    tankloc.ycord := yloc;
  144.  
  145.    while square[yloc][xloc] <> nothing do
  146.    begin
  147.       xloc := 1 + random(length);
  148.       yloc := 1 + random(width)
  149.    end;
  150.    square[yloc][xloc] := me;
  151.    myloc.xcord := xloc;
  152.    myloc.ycord := yloc;
  153. end;
  154.  
  155. (*
  156.  * print
  157.  * print out the field
  158.  *)
  159.  
  160. procedure print;
  161.  
  162. var
  163.    i : xindex;
  164.    j : yindex;
  165.  
  166. begin
  167.    for j := 1 to width do
  168.    begin
  169.       for i := 1 to length do
  170.          case square[j][i] of
  171.             me : write('*');
  172.             tank : write('T');
  173.             attacker : write('$');
  174.             mine : write('X');
  175.             nothing : write(' ')
  176.          end;
  177.       writeln
  178.    end
  179. end;
  180.  
  181. (*
  182.  * move
  183.  * attempt to move something from curx,cury in the direction
  184.  * indicated. returns what was on the location.
  185.  *)
  186.  
  187. function move(var curx:xindex;var cury:yindex;where:direction): what;
  188.  
  189. begin
  190.    case where of
  191.      n   : cury := cury - 1;
  192.      stay: ;
  193.      s   : cury := cury + 1;
  194.      w   : curx := curx - 1;
  195.      e   : curx := curx + 1;
  196.      nw  : begin
  197.               curx := curx - 1;
  198.               cury := cury - 1
  199.            end;
  200.      sw  : begin
  201.               curx := curx - 1;
  202.               cury := cury + 1
  203.            end;
  204.      ne  : begin
  205.               curx := curx + 1;
  206.               cury := cury - 1
  207.            end;
  208.      se  : begin
  209.               curx := curx + 1;
  210.               cury := cury + 1
  211.            end
  212.   end;
  213.  
  214.   move := square[cury][curx]
  215. end;
  216.  
  217. (*
  218.  * ask
  219.  * ask the user where he wants to go, then attempt to go there.
  220.  * returns what the player lands on.
  221.  *)
  222.  
  223. function ask:what;
  224.  
  225. var
  226.    command:array['0'..'9'] of direction;
  227.    dir    : direction;
  228.    ch     : char;
  229.  
  230. begin
  231.    (* init the commands *)
  232.    dir := stay;
  233.    for ch := '0' to '9' do
  234.    begin
  235.       command[ch] := dir;
  236.       dir := succ(dir)
  237.    end;
  238.  
  239.    write('Direction? ');
  240.    readln(ch);
  241.    if not (ch in ['0'..'9']) or ((ch = '9') and (nines = 0)) then
  242.    begin
  243.       writeln('How is that? ');
  244.       ask := ask
  245.    end
  246.  
  247.    else
  248.    begin
  249.       square[myloc.ycord][myloc.xcord] := nothing;
  250.       (* on a command of '9', relocate yourself randomly *)
  251.       if ch = '9' then
  252.       begin
  253.          nines := nines - 1;
  254.          myloc.ycord := 1 + random(width);
  255.          myloc.xcord := 1 + random(length);
  256.          ch := '0'
  257.       end;
  258.       saydir := command[ch];
  259.       ask := move(myloc.xcord,myloc.ycord,command[ch]);
  260.       square[myloc.ycord][myloc.xcord] := me
  261.    end
  262. end;
  263.  
  264. (*
  265.  * moveall
  266.  * moves all the attackers around, and the tank *)
  267.  
  268. procedure moveall;
  269.  
  270.  
  271. var
  272.    i   : 1..numattackers;   (* index used to run through all attackers *)
  273.  
  274. (*
  275.  * which
  276.  * given a loc, it decides which direction to go so as to come closer
  277.  * to you. returns the direction.
  278.  *)
  279.  
  280. function which(curr : loc):direction;
  281.  
  282. var
  283.    xdir,
  284.    ydir : direction;
  285.  
  286. begin
  287.    xdir := stay;
  288.    ydir := stay;
  289.  
  290.    if myloc.xcord > curr.xcord then
  291.       xdir := e
  292.    else
  293.       if myloc.xcord < curr.xcord then
  294.          xdir := w;
  295.  
  296.    if myloc.ycord > curr.ycord then
  297.       ydir := s
  298.    else
  299.       if myloc.ycord < curr.ycord then
  300.          ydir := n;
  301.  
  302.    if (xdir = stay) or (ydir = stay) then
  303.    begin
  304.       if xdir = stay then
  305.          which := ydir
  306.       else
  307.          which := xdir
  308.       end
  309.    else
  310.    begin
  311.       case xdir of
  312.          w: if ydir = n then
  313.                which := nw
  314.             else
  315.                which := sw;
  316.          e: if ydir = n then
  317.                which := ne
  318.             else
  319.                which := se;
  320.       end
  321.    end
  322. end;
  323.  
  324. (*
  325.  * checkmove
  326.  * checks to see what happens to an attacker when it is moved
  327.  *)
  328.  
  329. procedure checkmove(i : integer; dir : what);
  330.  
  331. var
  332.    remember,
  333.    index     : 1..numattackers;
  334.  
  335. begin
  336.    case dir of
  337.       nothing : square[atack[i].ycord][atack[i].xcord] := attacker;
  338.  
  339.       tank    : begin
  340.                    writeln('The tank just destroyed an attacker');
  341.                    atack[i].xcord := 0;
  342.                    left := left - 1
  343.                 end;
  344.       me      : begin
  345.                    writeln('You just died!!!');
  346.                    myloc.xcord := 0
  347.                 end;
  348.       attacker: begin
  349.                    (* find out which attacker we hit *)
  350.  
  351.                    for index := 1 to numattackers do
  352.                       if (atack[i].xcord = atack[index].xcord) and
  353.                          (atack[i].ycord = atack[index].ycord) and
  354.                          (i <> index) then
  355.                             remember := index;
  356.                    writeln('Two attackers just collided!');
  357.  
  358.                    (* remove it from the field *)
  359.                    square[atack[remember].ycord][atack[remember].xcord] := nothing;
  360.  
  361.                    (* choose a random spot for the first attacker *)
  362.                    atack[i].xcord := 1 + random(length);
  363.                    atack[i].ycord := 1 + random(width);
  364.  
  365.                    (* move the attacker *)
  366.                    checkmove(i,move(atack[i].xcord,atack[i].ycord,which(atack[i])));
  367.  
  368.                    (* repeat the same with the other attacker *)
  369.                    atack[remember].xcord := 1 + random(length);
  370.                    atack[remember].ycord := 1 + random(width);
  371.                    checkmove(remember,move(atack[remember].xcord,
  372.                              atack[remember].ycord,which(atack[remember])));
  373.                 end;
  374.       mine    : begin
  375.                    writeln('An attacker just hit a mine.');
  376.                    atack[i].xcord := 0;
  377.                    left := left - 1
  378.                 end
  379.    end;
  380. end;
  381.  
  382. begin
  383.    (* for each attacker, if he is still alive, move him toward you *)
  384.  
  385.    for i := 1 to numattackers do
  386.    begin
  387.       if atack[i].xcord <> 0 then
  388.       begin
  389.          square[atack[i].ycord][atack[i].xcord] := nothing;
  390.          checkmove(i,move(atack[i].xcord,atack[i].ycord,which(atack[i])))
  391.       end
  392.    end;
  393.  
  394.    (* move the tank, note that the tank will destroy anything in its way
  395.     * (including mines) *)
  396.  
  397.    square[tankloc.ycord][tankloc.xcord] := nothing;
  398.  
  399.    case move(tankloc.xcord,tankloc.ycord,which(tankloc)) of
  400.       attacker : begin
  401.                     writeln('The tank just destroyed an attacker');
  402.                     left := left - 1;
  403.                     for i := 1 to numattackers do
  404.                        if (atack[i].xcord = tankloc.xcord) and
  405.                           (atack[i].ycord = tankloc.ycord) then
  406.                              atack[i].xcord := 0
  407.                  end;
  408.  
  409.       mine     : writeln('The tank just destroyed a mine');
  410.  
  411.       me       : begin
  412.                     writeln('The tank just destroyed you');
  413.                     myloc.xcord := 0
  414.                  end;
  415.  
  416.       nothing  :
  417.  
  418.    end;
  419.    square[tankloc.ycord][tankloc.xcord] := tank
  420. end;
  421.  
  422. (*
  423.  * inst
  424.  * prints out the instructions
  425.  *)
  426.  
  427. procedure inst;
  428.  
  429. begin
  430.    writeln('     Dodge');
  431.    writeln(' You are in a 30 x 15 square. There are ',numattackers:1,' attackers,');
  432.    writeln(' one tank, and you. If you hit one of the attackers (or the tank)');
  433.    writeln(' you are destroyed. If two attackers hit each other, they are');
  434.    writeln(' randomly put somewhere else. If an attacker hits the tank, then');
  435.    writeln(' the attacker is destroyed. As an added bonus, there are ',numines);
  436.    writeln(' mines in the square (and the border of the square). If you hit');
  437.    writeln(' a mine, you are destroyed. If an attacker hits a mine, then the');
  438.    writeln(' attacker is destroyed. Your object is to destroy the attackers.');
  439.    writeln;
  440.    writeln(' You can move by:');
  441.    writeln('     812');
  442.    writeln('     703');
  443.    writeln('     654');
  444.    writeln(' Note that a 0 leaves you in the same place. A move of 9 will');
  445.    writeln(' put you in some random place on the square (even on a mine).');
  446.    writeln;
  447.    readln(ch);
  448. end;
  449.  
  450. (* dodge *)
  451.  
  452. begin
  453.    write('Want instructions? ');
  454.    readln(ch);
  455.    if (ch = 'y') or (ch = 'Y') then
  456.       inst;
  457.  
  458.  
  459.    repeat
  460.       randomize;
  461.  
  462.       makeboard;
  463.       print;
  464.       while (myloc.xcord <> 0) and (left > 0) do
  465.       begin
  466.          (* test to see if you killed yourself *)
  467.          if ask <> nothing then
  468.             myloc.xcord := 0
  469.          else
  470.          begin
  471.             moveall;
  472.             print
  473.          end;
  474.          writeln;
  475.       end;
  476.  
  477.       if myloc.xcord = 0 then
  478.          writeln('Well, you got yourself killed!!!')
  479.       else
  480.          writeln('Congratulations, you did it!!!');
  481.  
  482.       writeln;
  483.       write('Want to try again? ');
  484.       readln(ch)
  485.    until (ch <> 'y') and (ch <> 'Y');
  486.  
  487. end.
  488.  
  489.  
  490.  
  491.  
  492.